home *** CD-ROM | disk | FTP | other *** search
/ L' Effet Pommier 3 / L'Effet Pommier - Volume 03.iso / Programmation / Alpha ƒ / Tcl / SystemCode / html.tcl < prev    next >
Text File  |  1995-07-16  |  56KB  |  2,163 lines
  1. #================================================================================
  2. #
  3. # html.tcl:  macros and bindings for editing HTML documents.
  4. #
  5. # Copyright 1994,1995 by Scott W. Brim.  You may use this software freely, and
  6. # distribute it freely, as long as the receiver is not obligated in any 
  7. # way by receiving it.
  8. #
  9. # See HTML Help in the Help folder.
  10. # Original ideas taken from Marc Andreesen's html.el and Tom Scavo's latex.tcl.
  11. # If you make improvements, please share them!
  12. #
  13. #                                     Scott Brim <swb1@cornell.edu>
  14. #
  15. #================================================================================
  16. #
  17. # Change Log:
  18. #
  19. # Version 0.24, 04 July 1995
  20. #
  21. #    Fixed browser launching.
  22. #    Character entities now colored.
  23. #    URL prompt was messed up if user hadn't typed anything before double tab.
  24. #
  25. # Version 0.23, 14 June 1995
  26. #
  27. #    Remove 'processing instructions' - confusing some people.
  28. #    Less whitespace around <p> if text selected.
  29. #    Add optional HEIGHT=, WIDTH=, HSPACE= to IMG
  30. #
  31. # Version 0.22, 08 June 1995
  32. #
  33. #    Keybindings default to ctrl-opt, not cmd-opt.  Removed useCtlCmd option.
  34. #        User can now set keybinding prefixes.  See help file.
  35. #    Keybinding icons displayed in menus.
  36. #    "launch browser" moved to shift-cmd-S, standard for compilers.
  37. #    cmd-v, not ctrl-y pastes in statusBar.
  38. #    URL prompts done with prompt popup and menu (comments, please).
  39. #    Double tab when prompted for URL in statusBar puts up prompt window.
  40. #    htmlBrowserPath added to Mode:AppPaths menu.
  41. #    Allow custom definition of the htmlMenu icon or string (default Ñ942)
  42. #    Add optional WIDTH= to TH and TD
  43. #    Restore names "less than", etc., to commonly used characters list.
  44. #    Better colorizing.
  45. #    Slight fixes to Select Tag, Untag.
  46. #    Remove Tab Marks now bound to cmd-tab
  47. #
  48. # Version 0.21, 31 May 1995
  49. #
  50. #    IMG is no longer a container.
  51. #    Tuned statusbar handling of attribute choices using uppercase.
  52. #    Add "common characters" to char entity menu, with add and clear commands.
  53. #    Other messing with menus.
  54. #    Took out extra è.    
  55. #    Tuned cmd-B and Untag - still not universally satisfying.
  56. #    "Processing Instructions" (PIs, <?>) added to menu.
  57. #    Bind "untag" to shift-cmd-opt-u.
  58. #    Added method alternates for FORM.
  59. #    Avoid adding empty URLs to the list.
  60. #
  61. # Version 0.20, 21 May 1995
  62. #
  63. #    htmlBalance, on cmd-B, selects text between matching tags
  64. #    Added Untag to menu.  No keybinding yet.  Doesn't work if opening
  65. #        tag has a "/" in one of its attributes, but that should be rare.
  66. #
  67. # Version 0.19, 20 May 1995
  68. #
  69. #    browseInForeground flag: if set, switch to browser, otherwise leave
  70. #        browser in background (good if validating & lots of screen space)
  71. #    CLEAR= attribute for <BR>
  72. #    fixed bindings for &, <, and >
  73. #    ctrl-y pastes clipboard during statusbar prompts
  74. #    Put extra newlines back in
  75. #
  76. # Version 0.18, 10 May 1995
  77. #
  78. #    Tables
  79. #    User-custom menu support (see help file)
  80. #    Netscape attributes available (but not default) on BODY
  81. #    <LI>, <DT>, <DD> optionally closed 
  82. #    Add selection/clipboard to URL cache
  83. #    "id" allowed on all elements
  84. #    Fix lower-case behavior for Mosaic
  85. #    Extra checks on tab stops
  86. #    Launch browser, on opt-cmd-right
  87. #    Choice of case for elements again
  88. #    No extra <cr> out after containers on own line
  89. #    Fixed up <P> behavior
  90. #    Add opt-cmd-return binding for <P>
  91. #    A few more element attributes
  92. #    Spaces taken out after <LI>, <DD>, and <DT>
  93. #    Small fixes to NewTemplate
  94. #
  95. # Version 0.17, 02 May 1995
  96. #
  97. #    Renamed all mode-specific variables (redo your customizations)
  98. #    Lots of editorial manicuring (redo your customizations)
  99. #    Big experiment with element attributes in statusBar and popups
  100. #    Thanks to Ian Alderman for several ideas.
  101. #    Completely new menus, some dynamic
  102. #    All HTML 2.0 elements
  103. #    Assume Version 6.0
  104. #
  105. # Version 0.16, 30 November 1994
  106. #
  107. #    Split out htmlMode.tcl for faster startup.
  108. #    Take out single-character bindings <, >, & - collision with isearch.
  109. #    Clean up handling of HTML-specific flags and variables.  Fix help 
  110. #        accordingly.
  111. #    Support user keywords for coloring through variable HTMLwords (like Cwords).
  112. #    Add htmlDividingLine.
  113. #    Clump some text insertion for easier undo
  114. #
  115. # Version 0.15, 17 August 1994
  116. #
  117. #    HTML mode is now integrated into the main Alpha distribution.
  118. #    Better documentation all around.
  119. #    Use newModeVar and shadowing; remove requirement that certain flags 
  120. #        be set before or after html.tcl is loaded.
  121. #
  122. #===============================================================================
  123. #
  124. # To Do:
  125. #
  126. #    double tab with choices should put up listpick.
  127. #    Add cmd to turn chars in selection into entities
  128. #    parameterize template -- include HTMLmodeVars(htmlNewTmplHeadElems) {} and
  129. #        HTMLmodeVars(htmlNewTmplBodyElems) {} if they exist, on separate lines.
  130. #    Multiple URL cache sets.  
  131. #    URL cache popup: have 'file' option, allow standard file select
  132. #        routine, and format URL right.  Need relative vs. absolute paths,
  133. #        and translation of characters.  Either that or have URL menu item
  134. #        which does a file dialog (and translates chars etc.).
  135. #    Allow user to set color (via modeVar) - shadow it.
  136. #    Click (or something) on a tag -> jump into HTML spec for help.
  137. #    Lump more text inserts, integral for undo.  carriagereturn, openCR, closeCR.
  138. #    after launch browser, see if really launched (check list of processes)
  139. #    Better searching for headers for HTMLMarkFile, e.g. to find headers even
  140. #        when there are IMGs embedded in them.
  141. #    Select Container -- if one of p/li/dt/dd, see if there is another opening
  142. #        tag before the closing tag, in case user mixed uses.
  143. #    Proc to automatically put <P>s at newlines in region.
  144. #    cmd-doubleclick to follow local file URLs.  Perhaps notice <BASE>.
  145. #    htmlFillParagraph sensitive to HTML elements.
  146. #    better indentation management
  147. #    Automatically take a plaintext *'d list and turn it into a <ul> list.
  148. #    Customizable automatic insertion or changing of "last modified" line
  149. #    HTML3 mode - cut html.tcl in dependent and independent parts, create html3.tcl
  150. #================================================================================
  151.  
  152. #===============================================================================
  153. # Global variables and their management
  154. #===============================================================================
  155.  
  156. if {![info exists htmlMenu]} {set htmlMenu    "Ñ135"}
  157. # if {![info exists htmlMenu]} {set htmlMenu    "Ñ942"}
  158.  
  159. set commentPreString "<!-- "
  160. set commentSufString " -->"
  161.  
  162. newModeVar HTML wordWrap        1    1
  163. newModeVar HTML prefixString    $commentPreString    0
  164. newModeVar HTML suffixString    $commentSufString    0
  165. # how to fill in element attributes
  166. newModeVar HTML useStatusBar    0    1
  167. newModeVar HTML promptNoisily    1    1
  168. # Should elements be lower case?
  169. newModeVar HTML useLowerCase    0    1
  170. # Should Ñ's be inserted?
  171. newModeVar HTML    useTabMarks        1    1
  172. # Use opt-cmd or ctl-cmd?  Hack for int'l users.
  173. # commented out since moved to ctrl-opt
  174. # newModeVar HTML useCtlCmd        0    1
  175. # Are <p>, <li>, <dd>, <dl> containers?
  176. newModeVar HTML allContainers    1    1
  177. # A list of URLs, cached, to pick from for insertion
  178. newModeVar HTML URLs            {}    0
  179. # When browser is launched, should it be brought to front?
  180. newModeVar HTML    browseInForeground    1    1
  181. # Default number of discursive list entries
  182. newModeVar HTML    dlEntries        3    0
  183. # These element attributes require quotation marks
  184. newModeVar HTML quotedAttrs    {NAME= HREF= URN= TITLE= METHODS= SRC= ALT= ALIGN= \
  185.                                     ACTION= ENCTYPE= VALUE= CONTENT= ID=} 0
  186. # These element attributes are URLs (right now, anyway)
  187. newModeVar HTML URLAttrs    {HREF= URI= URN= SRC= ACTION=}    0
  188. # all elements get these
  189. newModeVar HTML elemAttrsForAll    {ID= }    0
  190. # list of commonly used character entities
  191. newModeVar HTML defaultCommonChars {"less than" "greater than" "ampersand"} 0
  192. newModeVar HTML commonChars $HTMLmodeVars(defaultCommonChars) 0
  193. # these are the prefixes for keybindings
  194. newModeVar HTML htmlBindPrefix    oz    0
  195. newModeVar HTML htmlSBindPrefix    soz    0
  196. newModeVar HTML htmlMenuPrefix    "<B<I"    0
  197. newModeVar HTML htmlSMenuPrefix    "<U<B<I"    0
  198.  
  199. #
  200. # this proc allows HTML mode arrays like newModeVar
  201. #
  202. proc htmlNewElemVar {list var val} {
  203.     global $list
  204.     if {![info exists ${list}($var)]} { set ${list}($var) $val }
  205. }
  206.  
  207. #
  208. # the per-element lists of all possible attributes
  209. #
  210. htmlNewElemVar htmlElemAttrAll    A    {HREF= NAME= REL= REV= TITLE= URN= METHODS=}
  211. htmlNewElemVar htmlElemAttrAll    ADDRESS    {}
  212. htmlNewElemVar htmlElemAttrAll    B    {}
  213. htmlNewElemVar htmlElemAttrAll    BASE    {HREF=}
  214. htmlNewElemVar htmlElemAttrAll    BLOCKQUOTE    {}
  215. htmlNewElemVar htmlElemAttrAll    BODY    {BACKGROUND= TEXT= LINK= VLINK= }
  216. htmlNewElemVar htmlElemAttrAll    BR    {CLEAR= }
  217. htmlNewElemVar htmlElemAttrAll    CAPTION    {ALIGN=}
  218. htmlNewElemVar htmlElemAttrAll    CENTER    {}
  219. htmlNewElemVar htmlElemAttrAll    CITE    {}
  220. htmlNewElemVar htmlElemAttrAll    CODE    {}
  221. htmlNewElemVar htmlElemAttrAll    DD    {}
  222. htmlNewElemVar htmlElemAttrAll    DIR    {COMPACT}
  223. htmlNewElemVar htmlElemAttrAll    DL    {COMPACT}
  224. htmlNewElemVar htmlElemAttrAll    DT    {}
  225. htmlNewElemVar htmlElemAttrAll    EM    {}
  226. htmlNewElemVar htmlElemAttrAll    FORM    {ACTION= METHOD= ENCTYPE= }
  227. htmlNewElemVar htmlElemAttrAll    H1    { }
  228. htmlNewElemVar htmlElemAttrAll    H2    { }
  229. htmlNewElemVar htmlElemAttrAll    H3    { }
  230. htmlNewElemVar htmlElemAttrAll    H4    { }
  231. htmlNewElemVar htmlElemAttrAll    H5    { }
  232. htmlNewElemVar htmlElemAttrAll    H6    { }
  233. htmlNewElemVar htmlElemAttrAll    HEAD    {}
  234. htmlNewElemVar htmlElemAttrAll    HR    {ALIGN= SIZE= WIDTH=}
  235. htmlNewElemVar htmlElemAttrAll    HTML    { }
  236. htmlNewElemVar htmlElemAttrAll    I    {}
  237. htmlNewElemVar htmlElemAttrAll    IMG    {SRC= ALT= ALIGN= BORDER= ISMAP HEIGHT= WIDTH= HSPACE=}
  238. htmlNewElemVar htmlElemAttrAll    INPUT    {NAME= TYPE= VALUE= CHECKED SIZE= ALIGN= SRC= }
  239. htmlNewElemVar htmlElemAttrAll    ISINDEX    {}
  240. htmlNewElemVar htmlElemAttrAll    KBD    {}
  241. htmlNewElemVar htmlElemAttrAll    LI    {}
  242. htmlNewElemVar htmlElemAttrAll    LINK    {HREF= REL= REV= TITLE=  URN= METHODS= }
  243. htmlNewElemVar htmlElemAttrAll    MENU    {COMPACT }
  244. htmlNewElemVar htmlElemAttrAll    META    {CONTENT= HTTP-EQUIV= NAME= }
  245. htmlNewElemVar htmlElemAttrAll    NEXTID    {N=}
  246. htmlNewElemVar htmlElemAttrAll    OL    {COMPACT }
  247. htmlNewElemVar htmlElemAttrAll    OPTION    {SELECTED VALUE=}
  248. htmlNewElemVar htmlElemAttrAll    P    {ALIGN= }
  249. htmlNewElemVar htmlElemAttrAll    PRE    {WIDTH= }
  250. htmlNewElemVar htmlElemAttrAll    SAMP    {}
  251. htmlNewElemVar htmlElemAttrAll    SELECT    {MULTIPLE NAME= SIZE= }
  252. htmlNewElemVar htmlElemAttrAll    STRONG    {}
  253. htmlNewElemVar htmlElemAttrAll    TABLE    {BORDER= BORDER CELLSPACING= CELLPADDING= WIDTH= }
  254. htmlNewElemVar htmlElemAttrAll    TEXTAREA    {NAME= ROWS= COLS= }
  255. htmlNewElemVar htmlElemAttrAll    TITLE    { }
  256. htmlNewElemVar htmlElemAttrAll    TD    {ALIGN= VALIGN= NOWRAP COLSPAN= ROWSPAN= WIDTH=}
  257. htmlNewElemVar htmlElemAttrAll    TH    {ALIGN= VALIGN= NOWRAP COLSPAN= ROWSPAN= WIDTH=}
  258. htmlNewElemVar htmlElemAttrAll    TR    {ALIGN= VALIGN= }
  259. htmlNewElemVar htmlElemAttrAll    TT    {}
  260. htmlNewElemVar htmlElemAttrAll    UL    {COMPACT}
  261. htmlNewElemVar htmlElemAttrAll    VAR    {}
  262.  
  263. #
  264. # element-specific attribute completions
  265. #
  266. htmlNewElemVar htmlElemAttrChoices    BR    {CLEAR=ALL CLEAR=LEFT CLEAR=RIGHT }
  267. htmlNewElemVar htmlElemAttrChoices    CAPTION    {ALIGN=BOTTOM ALIGN=TOP }
  268. htmlNewElemVar htmlElemAttrChoices    FORM    {METHOD=GET METHOD=POST}
  269. htmlNewElemVar htmlElemAttrChoices    INPUT    {TYPE=CHECKBOX TYPE=HIDDEN TYPE=IMAGE 
  270.         TYPE=PASSWORD TYPE=RADIO TYPE=RESET TYPE=SUBMIT TYPE=TEXT 
  271.         ALIGN=LEFT ALIGN=MIDDLE ALIGN=RIGHT}
  272. htmlNewElemVar htmlElemAttrChoices    IMG    {ALIGN=BOTTOM ALIGN=MIDDLE ALIGN=TOP ALIGN=LEFT ALIGN=RIGHT}
  273. htmlNewElemVar htmlElemAttrChoices    P    {ALIGN=LEFT ALIGN=MIDDLE ALIGN=RIGHT}
  274. htmlNewElemVar htmlElemAttrChoices    TR    {ALIGN=LEFT ALIGN=CENTER ALIGN=RIGHT 
  275.                                         VALIGN=BASELINE VALIGN=BOTTOM VALIGN=MIDDLE VALIGN=TOP }
  276. htmlNewElemVar htmlElemAttrChoices    TD    {ALIGN=LEFT ALIGN=CENTER ALIGN=RIGHT 
  277.                                         VALIGN=BASELINE VALIGN=BOTTOM VALIGN=MIDDLE VALIGN=TOP }
  278. htmlNewElemVar htmlElemAttrChoices    TH    {ALIGN=LEFT ALIGN=CENTER ALIGN=RIGHT 
  279.                                         VALIGN=BASELINE VALIGN=BOTTOM VALIGN=MIDDLE VALIGN=TOP }
  280.  
  281. #
  282. # the per-element list of attributes actually wanted at this time.
  283. #
  284. htmlNewElemVar htmlElemAttrUsed    A    {HREF= NAME=}
  285. htmlNewElemVar htmlElemAttrUsed    BASE    {HREF=}
  286. htmlNewElemVar htmlElemAttrUsed CAPTION    {ALIGN=}
  287. htmlNewElemVar htmlElemAttrUsed    DIR    {COMPACT}
  288. htmlNewElemVar htmlElemAttrUsed    DL    {COMPACT}
  289. htmlNewElemVar htmlElemAttrUsed    FORM    {ACTION=}
  290. htmlNewElemVar htmlElemAttrUsed    IMG    {SRC= ALT= ALIGN= ISMAP}
  291. htmlNewElemVar htmlElemAttrUsed    INPUT    {TYPE= NAME= VALUE= SRC= SIZE= MAXLENGTH= ALIGN=}
  292. htmlNewElemVar htmlElemAttrUsed    LINK    {HREF=}
  293. htmlNewElemVar htmlElemAttrUsed    MENU    {COMPACT}
  294. htmlNewElemVar htmlElemAttrUsed    META    {HTTP-EQUIV= NAME= CONTENT=}
  295. htmlNewElemVar htmlElemAttrUsed    NEXTID    {N=}
  296. htmlNewElemVar htmlElemAttrUsed    OPTION    {SELECTED VALUE=}
  297. htmlNewElemVar htmlElemAttrUsed    PRE    {WIDTH=}
  298. htmlNewElemVar htmlElemAttrUsed    SELECT    {NAME= SIZE= MULTIPLE}
  299. htmlNewElemVar htmlElemAttrUsed TABLE    {BORDER}
  300. htmlNewElemVar htmlElemAttrUsed TD        {NOWRAP ALIGN= VALIGN= COLSPAN= ROWSPAN=}
  301. htmlNewElemVar htmlElemAttrUsed    TEXTAREA    {NAME= ROWS= COLS=}
  302. htmlNewElemVar htmlElemAttrUsed TH        {NOWRAP ALIGN= VALIGN= COLSPAN= ROWSPAN=}
  303. htmlNewElemVar htmlElemAttrUsed    TR        {ALIGN= VALIGN=}
  304. #
  305. # these two are special (perhaps there will be more A types in the future)
  306. #
  307. htmlNewElemVar htmlElemAttrUsed    ANCHOR    {NAME=}
  308. htmlNewElemVar htmlElemAttrUsed    HREF    {HREF=}
  309.  
  310.  
  311. #
  312. # color support
  313. #
  314. # foreach t [array names htmlElemAttrAll] {
  315. #     set l [string tolower $t]
  316. #     set u [string toupper $t]
  317. #     lappend HTMLKeyWords <${l}> </${l}> <${u}> </${u}>
  318. # }
  319. set HTMLKeyWords {}
  320. if {[info exists HTMLwords]} {set HTMLKeyWords [concat $HTMLKeyWords $HTMLwords]}
  321. regModeKeywords -b "<" ">" -c blue -k blue HTML $HTMLKeyWords
  322. # regModeKeywords -b $commentPreString $commentSufString -m {<} -c red -k blue HTML $HTMLKeyWords
  323.  
  324.  
  325. #
  326. # Internal Globals
  327. #
  328. set htmlCurSel    ""
  329. set htmlIsSel    0
  330.  
  331. #===============================================================================
  332. # General Support Routines
  333. #===============================================================================
  334.  
  335. proc htmlNotYet {} {
  336.     alertnote "Not yet, but coming soon."
  337. }
  338.  
  339. proc htmlSetCase {elem} {
  340.     global HTMLmodeVars 
  341.     set useLowerCase $HTMLmodeVars(useLowerCase)
  342.     if {$useLowerCase} { 
  343.         return [string tolower $elem] 
  344.     } else {
  345.         return [string toupper $elem] 
  346.     }
  347. }
  348.  
  349. #
  350. # Mark file
  351. #
  352. # note - for this to work, the <h.. has to be at the left margin.  Given
  353. # that, one way to put anchors on headings is to have empty anchors
  354. # on the line above the heading, e.g. <a name="frob"></a>, then
  355. # <h2>Frobs and their Environment</h2>
  356. #
  357. proc HTMLMarkFile {} {
  358.     set end [maxPos]
  359.     set pos 0
  360.     set l {}
  361.     set exp {^(<[Aa][^>]*>)?<([Hh][1-6]>.*)</[Hh][1-6]>}
  362.  
  363.     while {![catch {search -f 1 -r 1 -m 0 -i 0 $exp $pos} res]} {
  364.         set start [lindex $res 0]
  365.         set end [lindex $res 1]
  366.         set text [lindex [split [getText $start $end] "<>"] 2]
  367.         set indlevel [getText [expr $start + 2] [expr $start + 3]]
  368.  
  369.         if {$indlevel > 0 && $indlevel < 7} {
  370.             set lab [string range "       " 2 $indlevel]
  371.             append lab $lab $indlevel " " $text
  372.             setNamedMark $lab $start $start $end
  373.         }
  374.  
  375.         set pos $end
  376.     }
  377. }
  378.  
  379. # Snatch the current selection into htmlCurSel, set flag whether there is one
  380. proc htmlGetSel {{sel ""}} {
  381.     global htmlCurSel htmlIsSel
  382.     set htmlCurSel [string trim $sel]
  383.     if {![string length $htmlCurSel]} {
  384.         set htmlCurSel [string trim [getSelect]]
  385.     }
  386.     set htmlIsSel [string length $htmlCurSel]
  387. }
  388.  
  389. #
  390. # return positions of tags of including elements, as a list of 4 numbers --
  391. # openstart openend closestart closeend.
  392. #
  393. # args: point to start search backward from; point which must be enclosed
  394. #
  395. # if any problem, return just {0}
  396. #
  397. proc htmlGetContainer {curPos inclPos} {
  398. #     set startPos [expr $curPos == 0 ? $curPos : [expr $curPos - 1]]
  399.     set startPos $curPos
  400.     # find first tag
  401.     if {[catch {search -f 0 -r 1 -i 0 -m 0 {<[^</>]+>} $startPos} res] ||
  402.             [lindex $res 0] > [maxPos]} {
  403.         return {0}
  404.     }
  405.     set tag1start [lindex $res 0]
  406.     set tag1end   [lindex $res 1]
  407.     # get element name
  408.     if {![regexp {<([^ \t]+).*>} [getText $tag1start $tag1end] tmp tag] ||
  409.             [string range $tag 0 0] == "/"} {
  410.         return {0}
  411.     }
  412.     # find closing tag
  413. #     append x {</} $tag {[ \t]*[^>]*>}
  414.     set x </${tag}>
  415.     if {[catch {search -f 1 -r 1 -i 1 -m 0 $x $tag1end} res] ||
  416.             [lindex $res 0] >= [maxPos]}    {
  417.         return {0}
  418.     }
  419.     set tag2start [lindex $res 0]
  420.     set tag2end   [lindex $res 1]
  421.  
  422.     # be careful of a container enclosed along with us
  423.     if {$tag2end < $inclPos} {
  424.         set tmp [htmlGetContainer [expr $tag1start - 1] $inclPos]
  425.         goto $curPos
  426.         return $tmp
  427.     }
  428.     goto $curPos
  429.     return "$tag1start $tag1end $tag2start $tag2end"
  430. }
  431.  
  432. #
  433. # dividing line
  434. #
  435. proc htmlDividingLine {} {
  436.     global HTMLmodeVars fillColumn
  437.     set wordWrap    $HTMLmodeVars(wordWrap)
  438.     set prefixString    $HTMLmodeVars(prefixString)
  439.     set suffixString    $HTMLmodeVars(suffixString)
  440.  
  441.     set s "===================================================================================="
  442.     set l [expr [string length $prefixString] + [string length $suffixString]]
  443.     if {$wordWrap} { 
  444.         set l [expr $fillColumn - $l - 1] 
  445.     } else {
  446.         set l [expr 75 - $l - 1]
  447.     }
  448.     insertText $prefixString [string range $s 0 $l] $suffixString
  449. }
  450.  
  451.  
  452. #
  453. # Carriage returns and tabs (much borrowed from latex.tcl)
  454. #
  455. # (there's a lot of cruft in here because I might lose it 
  456. # if I don't keep it here while I'm working on it.
  457. #
  458.  
  459. # A boolean function which takes any string and tests to see if
  460. # that string contains all whitespace characters.  Carriage returns 
  461. # are considered whitespace, as are spaces and tabs.
  462. proc htmlIsWhite {anyString} {
  463.     set len [string length $anyString]
  464.     for {set i 0} {$i < $len} {incr i} {
  465.         set c [string index $anyString $i]
  466.         if {($c != "\ ") && ($c != "\t") && ($c != "\r")} then {return 0}
  467.     }
  468.     return 1
  469. }
  470.  
  471. # Insert a carriage return at the insertion point if any
  472. # character preceding the insertion point (on the same line)
  473. # is a non-whitespace character.
  474. proc htmlOpenCR {} {
  475.     set end [getPos]
  476.     set start [lineStart $end]
  477.     set text [getText $start $end]
  478.     if {![htmlIsWhite $text]} carriageReturn
  479. }
  480.  
  481. # Insert a carriage return at the insertion point if any
  482. # character following the insertion point (on the same line)
  483. # is a non-whitespace character.
  484. proc htmlCloseCR {} {
  485.     set start [getPos]
  486.     set end [nextLineStart $start]
  487.     set text [getText $start $end]
  488.     if {![htmlIsWhite $text]} carriageReturn
  489. }
  490.  
  491. # Set up tab stop mechanism.
  492. proc htmlTabGoto {directionIndicator} {
  493.     set searchResult [search -n -f $directionIndicator -m 0 -i 1 -r 0 {Ñ} [getPos]]
  494.     if {![llength $searchResult] || [lindex $searchResult 0] >= [maxPos]} {
  495.         beep
  496.         message "Tab stop not found"
  497.         return 0
  498.     } else {
  499.         goto [lindex $searchResult 0]
  500.         return 1
  501.     }
  502. }
  503.  
  504. proc htmlTabNext {} {
  505.     if {[htmlTabGoto 1]} {deleteChar}
  506. }
  507.  
  508. proc htmlTabPrev {} {
  509.     if {[htmlTabGoto 0]} {deleteChar}
  510. }
  511.  
  512. proc htmlTabDeleteAll {} {
  513.     createTMark htmlDelTabMark [getPos]
  514.     goto 0
  515.     set searchpos 0
  516.     while {1} {
  517.         if {$searchpos == [maxPos]} break
  518.         set searchResult [search -f 1 -r 0 -m 0 -n {Ñ} $searchpos]
  519.         if {[llength $searchResult] == 0 || [lindex $searchResult 0] >= [maxPos]} break
  520.         deleteText [lindex $searchResult 0] [lindex $searchResult 1]
  521.         set searchpos [getPos]
  522.     }
  523.     message "Tab stops deleted"
  524.     gotoTMark htmlDelTabMark
  525.     removeTMark htmlDelTabMark
  526. }
  527.  
  528.  
  529.  
  530.  
  531. #===============================================================================
  532. # Building tags, including element attributes
  533. #===============================================================================
  534.  
  535. # Opening or only tag of an element - include attributes
  536. proc htmlOpenElem {elem {used ""}} {
  537.     global htmlActiveElem htmlElemAttrUsed htmlActiveUsed htmlActiveAttr htmlElemAttrChoices
  538.     global HTMLmodeVars
  539.     set promptNoisily    $HTMLmodeVars(promptNoisily)
  540.     set useStatusBar    $HTMLmodeVars(useStatusBar)
  541.     set URLAttrs    $HTMLmodeVars(URLAttrs)
  542.  
  543.     if {![string length $used]} {set used $elem}
  544.     set elem [string toupper $elem]
  545.     set used [string toupper $used]
  546.     
  547.     set htmlActiveUsed $used
  548.     set htmlActiveElem $elem
  549.     set text "<"
  550.     append text [htmlSetCase $elem]
  551.  
  552.     # if there are attributes to ask about, do so
  553.     if {![catch {set atts $htmlElemAttrUsed($used)}] && [string length $atts]} {
  554.         foreach attr $atts {
  555.             catch {unset tmp}
  556.             set htmlActiveAttr $attr
  557.             if {[lsearch -exact $URLAttrs $attr] >= 0} {
  558.                 set v [htmlAskURL $attr]
  559.                 if {[string length $v]} {
  560.                     append text " " [htmlSetCase $attr] [htmlCheckQuotes $attr $v]
  561.                 }
  562.             } elseif {$useStatusBar} {
  563.                 if {$promptNoisily} {beep}
  564.                 if {[string index $attr [expr [string length $attr] - 1]] == "="} {
  565.                     set v [string trim [statusPrompt ${elem}:$attr htmlAttrStatusFunc]]
  566.                     if {[string length $v]} {
  567.                         append text " " [htmlSetCase $attr] [htmlCheckQuotes $attr $v]
  568.                     }
  569.                 } else {
  570.                     set v [statusPrompt "${elem}:$attr \[n\] " htmlStatusAskYesOrNo]
  571.                     if {$v == "yes"} {append text " " [htmlSetCase $attr]}
  572.                 }
  573.             } else {
  574.                 if {[string index $attr [expr [string length $attr] - 1]] == "="} {
  575.                     set v [htmlAttrChoicePrompt $elem $attr]
  576.                     if {[string length $v]} {
  577.                         append text " " [htmlSetCase $attr] [htmlCheckQuotes $attr $v]
  578.                     }
  579.                 } else {
  580.                     if {[askyesno "${elem}:${attr}?"] == "yes"} {append text " " [htmlSetCase $attr]}
  581.                 }
  582.             }
  583.         }
  584.     }
  585.     append text ">"
  586.     catch {unset htmlActiveUsed}
  587.     catch {unset htmlActiveElem}
  588.     catch {unset htmlActiveAttr}
  589.     return ${text}
  590. }
  591.  
  592. # HREF attributes are handled as a listpick from a cached list
  593. proc htmlAskURL {attr} {
  594.     global modifiedModeVars htmlURLTabSeen
  595.     global HTMLmodeVars htmlActiveElem
  596.     set URLs    $HTMLmodeVars(URLs)
  597.     set useStatusBar    $HTMLmodeVars(useStatusBar)
  598.     set promptNoisily    $HTMLmodeVars(promptNoisily)
  599.     
  600.     if {$useStatusBar} {
  601.         if {$promptNoisily} {beep}
  602.         set htmlURLTabSeen 0
  603.         if {[catch {statusPrompt ${htmlActiveElem}:$attr htmlURLStatusFunc} r] ||
  604.                 ![string length $r]} { 
  605.             return "" 
  606.         }
  607.     } else {
  608.         set r [htmlPromptURL $attr "http://" $URLs]
  609.     }
  610.     set r [string trim $r]
  611.     if {[string length $r] && [lsearch -exact $URLs $r] < 0} { 
  612.         set URLs [lsort [lappend URLs $r]]
  613. #        We have to spin the disk each time or the value of URLs
  614. #        displayed in 'view user defs' won't be accurate.
  615. #        So far I don't want to spin the disk (for powerbook users)
  616. #         addArrDef HTMLmodeVars URLs $URLs
  617.         set HTMLmodeVars(URLs) $URLs
  618.         lappend modifiedModeVars {URLs HTMLmodeVars}
  619.     }
  620.     return $r
  621. }
  622.  
  623. # popup prompt for one from a list of URLs
  624. proc htmlPromptURL {attr pr URLs} {
  625.     global HTMLmodeVars htmlActiveElem
  626.     
  627.     if {![catch [concat [list prompt "${htmlActiveElem}:${attr}?" $pr ""] $URLs] r]} {
  628.         return $r
  629.     }
  630.     return ""
  631. }
  632.  
  633. proc htmlURLStatusFunc {curr c} {
  634.     global HTMLmodeVars htmlActiveElem htmlActiveAttr htmlURLTabSeen
  635.     set URLs $HTMLmodeVars(URLs)
  636.     
  637.     if {$c != "\t"} {
  638.         set htmlURLTabSeen 0
  639.         return $c
  640.     }
  641. #     # this was ctrl-y
  642. #     if {$c == "\031"} {
  643. #         set htmlURLTabSeen 0
  644. #         return [getScrap]
  645. #     }
  646.  
  647.     set matches {}
  648.     set attr $htmlActiveAttr
  649.     foreach w $URLs {
  650.         if {[string match "$curr*" $w]} {
  651.             lappend matches $w
  652.         }
  653.     }
  654.     if {![llength $matches]} {
  655.         beep
  656.     } else {
  657.         if {$htmlURLTabSeen} {
  658.             set pr $curr
  659.             if {![string length $pr]} {set pr "http://"}
  660.             set ret [htmlPromptURL $attr $pr $matches]
  661.             set ret [string range $ret [string length $curr] end]
  662.         } else {
  663.             set htmlURLTabSeen 1
  664.             set ret [string range [largestPrefix $matches] [string length $curr] end]
  665.         }
  666.         if {[string length $ret]} {
  667.             set htmlURLTabSeen 0
  668.             return $ret
  669.         }
  670.         beep
  671.     }
  672.     return ""
  673. }
  674.  
  675. # CDATA element attribute, status window match completion
  676. proc htmlAttrStatusFunc {curr c} {
  677.     global htmlElemAttrChoices htmlActiveUsed htmlActiveAttr
  678.         
  679.     # should we set the case or not (are there predefined choices)?
  680.     set choices {}
  681.     catch {set choices [concat choices $htmlElemAttrChoices($htmlActiveUsed)]}
  682.     set matches {}
  683.     set attr $htmlActiveAttr
  684.     foreach w $choices {
  685.         if {[string match [string toupper "${attr}$curr*"] $w]} {
  686.             lappend matches [string range $w [string length $attr] end]
  687.         }
  688.     }
  689.     # ctrl-y pastes clipboard
  690.     if {$c != "\t" && $c != "\031"} {
  691.         if {[llength $matches]} { set c [htmlSetCase $c] }
  692.         return $c
  693.     }
  694.     if {$c == "\031"} {
  695.         set c [getScrap]
  696.         if {[llength $matches]} { set c [htmlSetCase $c] }
  697.         return $c
  698.     }
  699.     # it's a tab
  700.     if {![llength $matches]} {
  701.         beep
  702.     } else {
  703.         set ret [string range [largestPrefix $matches] [string length $curr] end]
  704.         if {[string length $ret]} {return [htmlSetCase $ret]}
  705.         beep
  706.     }
  707.     return ""
  708. }
  709.  
  710. # Force yes or no in the status window
  711. proc htmlStatusAskYesOrNo {curr c} {
  712.     set c [string tolower $c]
  713.     if {[string length $curr] == 0} {
  714.         if {$c == "n"} {return "no"}
  715.         if {$c == "y"} {return "yes"}
  716.         if {$c == "N"} {return "no"}
  717.         if {$c == "Y"} {return "yes"}
  718.         beep
  719.         return ""
  720.     }
  721.     beep
  722.     return ""
  723. }
  724.  
  725. # Prompt in popup for attribute value, offering choices if any
  726. proc htmlAttrChoicePrompt {elem attr} {
  727.     global HTMLmodeVars htmlElemAttrChoices
  728.  
  729.     set choices {}
  730.     set matches {}
  731.     catch {set choices [concat choices $htmlElemAttrChoices($elem)]}
  732.     # see if there are choices
  733.     foreach w $choices {
  734.         if {[string match [string toupper "${attr}*"] $w]} {
  735.             lappend matches [string range $w [string length $attr] end]
  736.         }
  737.     }
  738.     set v ""
  739.     if {[llength $matches]} {
  740.     # if any, offer choices in a listpick
  741.         if {[catch {listpick -p ${elem}:${attr}? $matches} v]} {
  742.             return ""
  743.         }
  744.     } else {
  745.     # else prompt for value
  746.         if {[catch {prompt ${elem}:$attr "" } v]} {
  747.             return ""
  748.         }
  749.     }
  750.     set v [string trim $v]
  751.     return $v
  752. }
  753.  
  754. # If answer needs quotes, put them on
  755. proc htmlCheckQuotes {attr v} {
  756.     global HTMLmodeVars 
  757.     set quotedAttrs    $HTMLmodeVars(quotedAttrs)
  758.     
  759.     if {[string range $v 0 0] == "\""} {return $v}
  760.     if {[lsearch -exact $quotedAttrs $attr] >= 0} {return [append tmp "\"" $v "\""]}
  761.     return $v
  762. }
  763.  
  764.  
  765. # Closing tag of an element
  766. proc htmlCloseElem {theElem} {
  767.     set text ""
  768.     append text "</"
  769.     append text [htmlSetCase $theElem]
  770.     append text ">"
  771.     return $text
  772. }
  773.  
  774. # From menu, customize list of attributes which get asked about
  775. proc htmlUseAttrs {item} {
  776.     global HTMLmodeVars htmlElemAttrAll htmlElemAttrUsed elemAttrsForAll
  777.     global modifiedVars
  778.     
  779.     set attrname $item
  780.     set usedname $item
  781.     if {![info exists htmlElemAttrAll($item)]} {
  782.         # hope it's A HREF/ANCHOR
  783.         if {$item == "A HREF"} {
  784.             set attrname A
  785.             set usedname HREF
  786.         } elseif {$item == "A ANCHOR"} {
  787.             set attrname A
  788.             set usedname ANCHOR
  789.         } else { 
  790.             alertnote "Bug! There's an element in the menu which should not be there!"
  791.             return 1
  792.         }
  793.     }
  794.     if {![catch {listpick -l -p "Select the attributes you usually want for $usedname" \
  795.             [concat $htmlElemAttrAll($attrname) $elemAttrsForAll]} newattrs]} {
  796.         set newattrs [eval concat $newattrs]
  797.         set htmlElemAttrUsed($usedname) $newattrs
  798.          addArrDef htmlElemAttrUsed $usedname $newattrs
  799. #         addUserLine "set htmlElemAttrUsed($usedname) \{ $newattrs \}"
  800. #        lappend modifiedVars [append tmp {htmlElemAttrUsed(} $usedname {)}]
  801.     }
  802. }
  803.  
  804.  
  805. #===============================================================================
  806. # Elements
  807. #===============================================================================
  808.  
  809. #
  810. # First the ones with just one tag or which just don't fit elsewhere
  811. #
  812.  
  813. proc htmlElemBase {} {
  814. #    carriageReturn
  815.     insertText [htmlOpenElem "BASE"]
  816.     carriageReturn
  817. }
  818.  
  819. proc htmlBreak {} {
  820.     insertText [htmlOpenElem "BR"]
  821.     carriageReturn
  822. }
  823.  
  824. proc htmlComment {} {
  825.     global htmlCurSel
  826.     global htmlIsSel
  827.     global HTMLmodeVars
  828.     set useTabMarks    $HTMLmodeVars(useTabMarks)
  829.     set commentPreString    $HTMLmodeVars(prefixString)
  830.     set commentSufString    $HTMLmodeVars(suffixString)
  831.  
  832.     htmlGetSel
  833.     if {$htmlIsSel} { deleteSelection }
  834.     htmlOpenCR
  835.     insertText $commentPreString $htmlCurSel 
  836.     set currpos [getPos]
  837.     insertText $commentSufString
  838.     htmlCloseCR
  839.     if {!$htmlIsSel}    {
  840.         if {$useTabMarks} {insertText "Ñ"}
  841.         goto $currpos
  842.     }
  843. }
  844.  
  845. proc htmlElemHR {} {
  846.     carriageReturn
  847.     insertText [htmlOpenElem "HR"]
  848.     carriageReturn
  849.     message "Horizontal Rule"
  850. }
  851.  
  852. # processing instructions
  853. # proc htmlElemPI {} {
  854. #     insertText "<?>Ñ"
  855. #     backwardChar
  856. #     backwardChar
  857. # }
  858.  
  859. #
  860. # Element build routines
  861. #
  862.  
  863. # This is used for almost all containers
  864. proc htmlBuildElem {ftype {attr ""}} {
  865.     global HTMLmodeVars
  866.     set useTabMarks    $HTMLmodeVars(useTabMarks)
  867.     global htmlCurSel
  868.     global htmlIsSel
  869.  
  870.     set text ""
  871.     htmlGetSel
  872.     if {$htmlIsSel} { deleteSelection }
  873.     append text [htmlOpenElem $ftype $attr]
  874.     append text $htmlCurSel
  875.     set currpos [expr [getPos] + [string length $text]]
  876.     append text [htmlCloseElem $ftype]
  877.     if {!$htmlIsSel && $useTabMarks} {append text "Ñ"}
  878.     insertText $text
  879.     if {!$htmlIsSel} {goto $currpos}
  880. }
  881.  
  882. # This is used for elements that should be surrounded by newlines
  883. proc htmlBuildCRElem {ftype {sel ""}} {
  884.     global htmlCurSel htmlIsSel
  885.     global HTMLmodeVars
  886.     set useTabMarks $HTMLmodeVars(useTabMarks)
  887.  
  888.     set text ""
  889.     htmlGetSel $sel
  890.     if {$htmlIsSel} { deleteSelection }
  891.     htmlOpenCR
  892.     append text [htmlOpenElem $ftype]
  893.     append text $htmlCurSel
  894.     set currpos [expr [getPos] + [string length $text]]
  895.     append text [htmlCloseElem $ftype]
  896.     insertText $text
  897.     carriageReturn
  898.     if {!$htmlIsSel}    {
  899.         if {$useTabMarks} {insertText "Ñ"}
  900.         goto $currpos
  901.     }
  902. }
  903.  
  904. # This is used for elements that should be surrounded by empty lines
  905. proc htmlBuildCR2Elem {ftype {sel ""}} {
  906.     global HTMLmodeVars htmlCurSel htmlIsSel
  907.     set useTabMarks    $HTMLmodeVars(useTabMarks)
  908.     
  909.     htmlGetSel $sel
  910.     if {$htmlIsSel} { deleteSelection }
  911. # note elems are currently placed at left margin, ignoring current indent
  912.     htmlOpenCR ; insertText "\n"
  913.     insertText [htmlOpenElem $ftype]
  914.     carriageReturn
  915.     insertText $htmlCurSel
  916.     set currpos [getPos]
  917.     insertText "\n"
  918.     insertText [htmlCloseElem $ftype]
  919.     htmlCloseCR ; carriageReturn
  920.     if {!$htmlIsSel}    {
  921.         if {$useTabMarks} {insertText "Ñ"}
  922.         goto $currpos
  923.     }
  924. }
  925.  
  926. # Lists: Puts <cr>s before and after a list, inserts <li>, leaves the
  927. # insertion point there.  If anything is selected, makes it the first item.
  928. proc htmlBuildList {ltype} {
  929.     global HTMLmodeVars
  930.     set useTabMarks $HTMLmodeVars(useTabMarks)
  931.     set allContainers    $HTMLmodeVars(allContainers)
  932.     global htmlCurSel
  933.     global htmlIsSel
  934.  
  935.     htmlGetSel
  936.     set sel $htmlCurSel
  937.     set IsSel $htmlIsSel
  938.     if {$IsSel} { deleteSelection }
  939.     htmlOpenCR
  940.     carriageReturn
  941.     insertText [htmlOpenElem $ltype]
  942.     carriageReturn
  943.     if {$allContainers} {
  944.         htmlBuildElem "LI"
  945.     } else {
  946.         insertText [htmlOpenElem "LI"]
  947.     }
  948.     if {$IsSel} {        # bullet 1 already full
  949.         insertText $sel 
  950.         if {$allContainers} {
  951.             if {$useTabMarks} {
  952.                 htmlTabNext
  953.             } else {
  954.                 goto [expr [getPos] + 5]
  955.             }
  956.             carriageReturn
  957.             htmlBuildElem "LI"
  958.         } else {
  959.             carriageReturn
  960.             insertText [htmlOpenElem "LI"]
  961.         }
  962.     }
  963.     set currpos [getPos]
  964.     if {$allContainers} { 
  965.         if {$useTabMarks} {
  966.             set i 6
  967.         } else {
  968.             set i 5
  969.         }
  970.         goto [expr [getPos] + $i]
  971.     }
  972.     carriageReturn
  973.     insertText [htmlCloseElem $ltype]
  974.     carriageReturn
  975.     if {$useTabMarks} {insertText "Ñ"}
  976.     htmlCloseCR
  977.     goto $currpos
  978. }
  979.  
  980. # Add list entry.  If there is a selection, make it the entry.
  981. proc htmlElemListEntry {} {
  982.     global htmlCurSel htmlIsSel HTMLmodeVars
  983.     set allContainers    $HTMLmodeVars(allContainers)
  984.     htmlGetSel
  985.     htmlOpenCR
  986.     set Sel $htmlCurSel
  987.     if {$allContainers} {
  988.         htmlBuildElem "LI"
  989.     } else {
  990.         insertText [htmlOpenElem "LI"]
  991.     }
  992.     insertText $Sel
  993. }
  994.  
  995. # Discursive Lists (term and description elems)
  996. #
  997. # The selection becomes the *description* (*not* the term)
  998.  
  999. # Build a discursive list
  1000. proc htmlBuildDiscList {} {
  1001.     global htmlCurSel
  1002.     global htmlIsSel
  1003.     global HTMLmodeVars 
  1004.     set allContainers    $HTMLmodeVars(allContainers)
  1005.     set useTabMarks    $HTMLmodeVars(useTabMarks)
  1006.     set dlEntries    $HTMLmodeVars(dlEntries)
  1007.  
  1008.     htmlGetSel
  1009.     set Sel $htmlCurSel
  1010.     if {$htmlIsSel} { deleteSelection }
  1011.     htmlOpenCR
  1012.     carriageReturn
  1013.     insertText [htmlOpenElem "DL"]
  1014.     carriageReturn
  1015.  
  1016.     # The first entry
  1017.     if {$allContainers} {
  1018.         htmlBuildElem "DT"
  1019.     } else {
  1020.         insertText [htmlOpenElem "DT"]
  1021.     }
  1022. #    insertText [htmlOpenElem "DT"]
  1023.     set currpos [getPos]
  1024.     if {$allContainers} {
  1025.         if {$useTabMarks} {
  1026.             htmlTabNext
  1027.         } else {
  1028.             goto [expr [getPos] + 5]
  1029.         }
  1030.     }
  1031.     insertText "\t"
  1032.     if {$allContainers} {
  1033.         htmlBuildElem "DD"
  1034.     } else {
  1035.         insertText [htmlOpenElem "DD"]
  1036.     }
  1037. #    insertText [htmlOpenElem "DD"]
  1038.     if {[string length $Sel]} {
  1039.         insertText $Sel
  1040.     } else {
  1041.         if {$useTabMarks} {insertText "Ñ"}
  1042.     }        
  1043.     if {$allContainers} {
  1044.         if {$useTabMarks} {
  1045.             htmlTabNext
  1046.         } else {
  1047.             goto [expr [getPos] + 5]
  1048.         }
  1049.     }
  1050.  
  1051.     # Now for the rest of the entries
  1052.     for {set i 1} {$i < $dlEntries} {incr i} {
  1053.         carriageReturn
  1054.         if {$allContainers} {
  1055.             htmlBuildElem "DT"
  1056.         } else {
  1057.             insertText [htmlOpenElem "DT"]
  1058.         }
  1059. #        insertText [htmlOpenElem "DT"]
  1060.         if {$useTabMarks} {insertText "Ñ"}
  1061.         if {$allContainers} {
  1062.             if {$useTabMarks} {
  1063.                 htmlTabNext
  1064.             } else {
  1065.                 goto [expr [getPos] + 5]
  1066.             }
  1067.         }
  1068.         insertText "\t"
  1069.         if {$allContainers} {
  1070.             htmlBuildElem "DD"
  1071.         } else {
  1072.             insertText [htmlOpenElem "DD"]
  1073.         }
  1074. #        insertText [htmlOpenElem "DD"]
  1075.         if {$useTabMarks} {insertText "Ñ"}
  1076.         if {$allContainers} {
  1077.             if {$useTabMarks} {
  1078.                 htmlTabNext
  1079.             } else {
  1080.                 goto [expr [getPos] + 5]
  1081.             }
  1082.         }
  1083.     }
  1084.     if {$allContainers && $useTabMarks} {insertText "Ñ"}
  1085.     carriageReturn
  1086.     insertText [htmlCloseElem "DL"]
  1087.     carriageReturn
  1088.     if {$useTabMarks} {insertText "Ñ"}
  1089.     htmlCloseCR
  1090.     goto $currpos
  1091. }
  1092.  
  1093. # Add an individual entry to a discursive list
  1094. proc htmlElemDiscEntry {} {
  1095.     global htmlCurSel htmlIsSel
  1096.     global HTMLmodeVars
  1097.     set useTabMarks    $HTMLmodeVars(useTabMarks)
  1098.     set allContainers    $HTMLmodeVars(allContainers)
  1099.     
  1100.     htmlGetSel
  1101.     if {$htmlIsSel} { deleteSelection }
  1102.     set Sel $htmlCurSel
  1103.     htmlOpenCR
  1104.     
  1105.     if {$allContainers} {
  1106.         htmlBuildElem "DT"
  1107.     } else {
  1108.         insertText [htmlOpenElem "DT"]
  1109.     }
  1110.     set currpos [getPos]
  1111.     if {$allContainers} {
  1112.         if {$useTabMarks} {
  1113.             htmlTabNext
  1114.         } else {
  1115.             goto [expr [getPos] + 5]
  1116.         }
  1117.     }
  1118.     insertText "\t"
  1119.     if {$allContainers} {
  1120.         htmlBuildElem "DD"
  1121.     } else {
  1122.         insertText [htmlOpenElem "DD"]
  1123.     }
  1124.     if {[string length $Sel]} {
  1125.         insertText $Sel
  1126.     } else {
  1127.         if {$useTabMarks} {insertText "Ñ"}
  1128.     }
  1129.     if {!$allContainers} {htmlCloseCR}
  1130.     goto $currpos
  1131. }
  1132.  
  1133.  
  1134. #
  1135. # Here are all the things that use the Build procs
  1136. #
  1137.  
  1138. proc htmlElemParagraph {} {
  1139.     global htmlIsSel htmlCurSel HTMLmodeVars
  1140.     set allContainers    $HTMLmodeVars(allContainers)
  1141.     
  1142.     set htmlCurSel ""
  1143.     htmlGetSel
  1144.     # we need to use a local variable to hold the selection since carriageReturn
  1145.     #    deletes the current selection.
  1146.     set sel $htmlCurSel
  1147.     if {[string length $sel]} { deleteSelection }
  1148.     if ($allContainers) { 
  1149.         if {![string length $sel]} {
  1150.             htmlOpenCR
  1151.             carriageReturn
  1152.         }
  1153.         htmlBuildCRElem "P" 
  1154.         if {[string length $sel]} {insertText $sel}
  1155.     } else {
  1156.         if {![string length $sel]} {
  1157.             htmlOpenCR
  1158.             carriageReturn
  1159.         }
  1160.         insertText [htmlOpenElem "P"]
  1161.         if {[string length $sel]} {insertText $sel}
  1162.     }
  1163. }
  1164.  
  1165. proc htmlElemAddress {} {
  1166.     htmlBuildCRElem "ADDRESS"
  1167.     message "Address"
  1168. }
  1169. proc htmlElemBlockquote {} {
  1170.     htmlBuildCR2Elem "BLOCKQUOTE"
  1171.     message "Blockquote"
  1172. }
  1173. proc htmlElemBold {} {
  1174.     htmlBuildElem "B"
  1175.     message "Bold"
  1176. }
  1177. proc htmlElemCite {} {
  1178.     htmlBuildElem "CITE"
  1179.     message "Cite"
  1180. }
  1181. proc htmlElemCode {} {
  1182.     htmlBuildElem "CODE"
  1183.     message "Code"
  1184. }
  1185. proc htmlElemEmphasized {} {
  1186.     htmlBuildElem "EM"
  1187.     message "Emphasized"
  1188. }
  1189. proc htmlElemTT {} {
  1190.     htmlBuildElem "TT"
  1191.     message "Fixed Width"
  1192. }
  1193. proc htmlElemItalic {} {
  1194.     htmlBuildElem "I"
  1195.     message "Italic"
  1196. }
  1197. proc htmlElemKeyboard {} {
  1198.     htmlBuildElem "KBD"
  1199.     message "Keyboard"
  1200. }
  1201.  
  1202. proc htmlElemSample {} {
  1203.     htmlBuildElem "SAMP"
  1204.     message "Sample"
  1205. }
  1206. proc htmlElemStrong {} {
  1207.     htmlBuildElem "STRONG"
  1208.     message "Strong emphasis"
  1209. }
  1210. proc htmlElemVarname {} {
  1211.     htmlBuildElem "VAR"
  1212.     message "Variable name"
  1213. }
  1214. proc htmlElemPreformatted {} {
  1215.     htmlBuildCR2Elem "PRE"
  1216.     message "Preformatted"
  1217. }
  1218. proc htmlElemCenter {} {
  1219.     htmlBuildCR2Elem "CENTER"
  1220.     message "Netscape Enhanced center"
  1221. }
  1222.  
  1223. proc htmlElemTitle {} {
  1224.     htmlBuildCRElem "TITLE"
  1225.     message "External title"
  1226. }
  1227.  
  1228.  
  1229. proc htmlElemHeader1 {} {
  1230.     global htmlCurSel htmlIsSel
  1231.     set sel ""
  1232.      htmlGetSel
  1233.      if {$htmlIsSel} {set sel $htmlCurSel}
  1234.       carriageReturn
  1235.     htmlBuildCRElem H1 $sel
  1236. }
  1237. proc htmlElemHeader2 {} {
  1238.     global htmlCurSel htmlIsSel
  1239.     set sel ""
  1240.      htmlGetSel
  1241.      if {$htmlIsSel} {set sel $htmlCurSel}
  1242.       carriageReturn
  1243.     htmlBuildCRElem H2 $sel
  1244. }
  1245. proc htmlElemHeader3 {} {
  1246.     global htmlCurSel htmlIsSel
  1247.     set sel ""
  1248.      htmlGetSel
  1249.      if {$htmlIsSel} {set sel $htmlCurSel}
  1250.       carriageReturn
  1251.     htmlBuildCRElem H3 $sel
  1252. }
  1253. proc htmlElemHeader4 {} {
  1254.     global htmlCurSel htmlIsSel
  1255.     set sel ""
  1256.      htmlGetSel
  1257.      if {$htmlIsSel} {set sel $htmlCurSel}
  1258.       carriageReturn
  1259.     htmlBuildCRElem H4 $sel
  1260. }
  1261. proc htmlElemHeader5 {} {
  1262.     global htmlCurSel htmlIsSel
  1263.     set sel ""
  1264.      htmlGetSel
  1265.      if {$htmlIsSel} {set sel $htmlCurSel}
  1266.       carriageReturn
  1267.     htmlBuildCRElem H5 $sel
  1268. }
  1269. proc htmlElemHeader6 {} {
  1270.     global htmlCurSel htmlIsSel
  1271.     set sel ""
  1272.      htmlGetSel
  1273.      if {$htmlIsSel} {set sel $htmlCurSel}
  1274.       carriageReturn
  1275.     htmlBuildCRElem H6 $sel
  1276. }
  1277.  
  1278. #
  1279. # These things use BuildList
  1280. #
  1281.  
  1282. proc htmlElemBulleted {} {
  1283.     htmlBuildList "UL"
  1284.     message "Bulleted list"
  1285. }
  1286. proc htmlElemNumbered {} {
  1287.     htmlBuildList "OL"
  1288. }
  1289. proc htmlElemMenu {} {
  1290.     htmlBuildList "MENU"
  1291. }
  1292. proc htmlElemDirectory {} {
  1293.     htmlBuildList "DIR"
  1294. }
  1295.  
  1296. # links
  1297. #
  1298. # Href and Anchor are an 'A' with different attribute sets.
  1299.  
  1300. proc htmlElemHref {} {
  1301.     htmlBuildElem A HREF    
  1302. }
  1303.  
  1304. # If text is selected it is the object of the href.
  1305. proc htmlElemAnchor {} {
  1306.     htmlBuildElem A ANCHOR
  1307. }
  1308.  
  1309. # Inline image href
  1310. proc htmlElemImg {} {
  1311.     insertText [htmlOpenElem IMG]
  1312. }
  1313.  
  1314. # Forms - no template (yet?)
  1315. proc htmlElemForm {} {
  1316.     global htmlCurSel htmlIsSel
  1317.     set sel ""
  1318.      htmlGetSel
  1319.      if {$htmlIsSel} {set sel $htmlCurSel}
  1320.       carriageReturn
  1321.     htmlBuildCR2Elem "FORM" $sel
  1322. }
  1323. proc htmlElemSelect {} {
  1324.     htmlBuildCRElem SELECT
  1325. }
  1326. proc htmlElemOption {} {
  1327.     insertText [htmlOpenElem "OPTION"]
  1328. }
  1329. proc htmlElemInput {} {
  1330.     insertText [htmlOpenElem INPUT]
  1331. }
  1332. proc htmlElemTextarea {} {
  1333.     htmlBuildCRElem "TEXTAREA"
  1334. }
  1335.  
  1336. # Tables
  1337. proc htmlElemTable {} {
  1338.     global htmlCurSel htmlIsSel
  1339.     set sel ""
  1340.      htmlGetSel
  1341.      if {$htmlIsSel} {set sel $htmlCurSel}
  1342.       carriageReturn
  1343.     htmlBuildCR2Elem "TABLE" $sel
  1344. }
  1345. proc htmlElemTR {} {
  1346.     htmlBuildCRElem "TR"
  1347. }
  1348. proc htmlElemTD {} {
  1349.     htmlBuildElem "TD"
  1350. }
  1351. proc htmlElemTH {} {
  1352.     htmlBuildElem "TH"
  1353. }
  1354. proc htmlElemCaption {} {
  1355.     htmlBuildCRElem "CAPTION"
  1356. }
  1357.  
  1358. #
  1359. # Template for new file: HTML, TITLE, HEAD, BODY
  1360. # We do not put in a DOCTYPE line.
  1361. # Someday %include user-defined elements as well.
  1362. #
  1363. proc htmlNewTemplate {} {
  1364.     global htmlCurSel htmlIsSel HTMLmodeVars
  1365.     set useTabMarks    $HTMLmodeVars(useTabMarks)
  1366.  
  1367.     htmlGetSel
  1368.     set htmlTTIsSel $htmlIsSel
  1369.     if {$htmlTTIsSel} { 
  1370.         set htmlTTCurSel $htmlCurSel
  1371.         deleteSelection 
  1372.     }
  1373.     insertText [htmlOpenElem "HTML"]
  1374.     htmlBuildCRElem "HEAD"
  1375.     htmlBuildCRElem "TITLE"
  1376.     if {$htmlTTIsSel} {
  1377.         insertText $htmlTTCurSel
  1378.     } else {
  1379.         createTMark htmlTTMark [getPos]
  1380.     }
  1381.     htmlTabNext; htmlTabNext
  1382.     htmlBuildCRElem "BODY"
  1383.     if {!$htmlTTIsSel} {
  1384.         if {$useTabMarks} {insertText "\nÑ\n"}
  1385.     } else {
  1386.         insertText "\n"
  1387.         createTMark htmlTTMark [getPos]
  1388.         insertText "\n"
  1389.     }
  1390.     htmlTabNext
  1391.     insertText [htmlCloseElem "HTML"]
  1392.     gotoTMark htmlTTMark
  1393.     removeTMark htmlTTMark
  1394.     message "Consider a DOCTYPE line for HTML version identification."
  1395. }
  1396.  
  1397.  
  1398. #===============================================================================
  1399. # HTML character entities
  1400. #===============================================================================
  1401.  
  1402. proc htmlAddCommonChars {} {
  1403.     global modifiedModeVars HTMLmodeVars htmlAllChars
  1404.     set commonChars $HTMLmodeVars(commonChars)
  1405.  
  1406.     if {![catch {listpick -l -p "Select chars for the commonly used char list" \
  1407.                 $htmlAllChars} newchars]} {
  1408.         # set newchars [eval concat $newchars]
  1409.         set dirty 0
  1410.         foreach c $newchars {
  1411.             if {[lsearch -exact $commonChars $c] < 0} {
  1412.                 set dirty 1
  1413.                 set commonChars [lsort [lappend commonChars $c]]
  1414.             }
  1415.         }
  1416.         if {$dirty} {
  1417.             lappend modifiedModeVars {commonChars HTMLmodeVars}
  1418.             set HTMLmodeVars(commonChars) $commonChars
  1419.             htmlBuildMenu
  1420.         }
  1421.     }
  1422. }
  1423.  
  1424. proc htmlClearCommonChars {} {
  1425.     global htmlAllChars modifiedModeVars HTMLmodeVars
  1426.     
  1427.     set HTMLmodeVars(commonChars) $HTMLmodeVars(defaultCommonChars)
  1428.     lappend modifiedModeVars {commonChars HTMLmodeVars}
  1429.     htmlBuildMenu
  1430.     message "Common character list reverted to default"
  1431. }
  1432.  
  1433. # less than
  1434. proc htmlLt {} {
  1435.     global htmlIsSel
  1436.     htmlGetSel
  1437.     if {$htmlIsSel} { deleteSelection }
  1438.     insertText "<\;"
  1439. }
  1440. # greater than
  1441. proc htmlGt {} {
  1442.     global htmlIsSel
  1443.     htmlGetSel
  1444.     if {$htmlIsSel} { deleteSelection }
  1445.     insertText ">\;"
  1446. }
  1447. # ampersand
  1448. proc htmlAmp {} {
  1449.     global htmlIsSel
  1450.     htmlGetSel
  1451.     if {$htmlIsSel} { deleteSelection }
  1452.     insertText "&\;"
  1453. }
  1454.  
  1455.  
  1456.  
  1457. #===============================================================================
  1458. # Menu Processing
  1459. #===============================================================================
  1460.  
  1461. proc htmlMenuItem {menu item} {
  1462.     global htmlIsSel htmlMenu
  1463.  
  1464.     switch -glob $menu {
  1465.         "Ñ*" {
  1466.             switch $item {
  1467.                 "Select Container"    {htmlBalance}
  1468.                 "Untag"                {htmlUnTag}
  1469.                 "Remove marks"        {htmlTabDeleteAll}
  1470.                 "New doc template"    {htmlNewTemplate}
  1471.             }
  1472.         }
  1473.         "Headers" {
  1474.              switch $item {
  1475.                 "Header1"    {htmlElemHeader1}
  1476.                 "Header2"    {htmlElemHeader2}
  1477.                 "Header3"    {htmlElemHeader3}
  1478.                 "Header4"    {htmlElemHeader4}
  1479.                 "Header5"    {htmlElemHeader5}
  1480.                 "Header6"    {htmlElemHeader6}
  1481.             }
  1482.         }
  1483.         "Text Blocks" {
  1484.             switch $item {
  1485.                 "paragraph"    {htmlElemParagraph}
  1486.                 "comment"    {htmlComment}
  1487.                 "address"    {htmlElemAddress}
  1488.                 "block quote"    {htmlElemBlockquote}
  1489.                 "preformatted"    {htmlElemPreformatted}
  1490.                 "center"        {htmlElemCenter}
  1491.             }
  1492.         }
  1493.         "Styles"    {
  1494.             switch $item {
  1495.                 "emphasis"        {htmlElemEmphasized}
  1496.                 "strong"        {htmlElemStrong}
  1497.                 "bold"            {htmlElemBold}
  1498.                 "italic"        {htmlElemItalic}
  1499.                 "code"            {htmlElemCode}
  1500.                 "variable"        {htmlElemVarname}
  1501.                 "citation"        {htmlElemCite}
  1502.                 "keyboard"        {htmlElemKeyboard}
  1503.                 "typewriter"    {htmlElemTT}
  1504.                 "sample"        {htmlElemSample}
  1505.             }
  1506.         }
  1507.         "Links"    {
  1508.             switch $item {
  1509.                 "href"    {htmlElemHref}
  1510.                 "anchor"    {htmlElemAnchor}
  1511.                 "image"    {htmlElemImg}
  1512.             }
  1513.         }
  1514.         "Lists"    {
  1515.             switch $item {
  1516.                 "bulleted"    {htmlElemBulleted}
  1517.                 "numbered"    {htmlElemNumbered}
  1518.                 "directory"    {htmlElemDirectory}
  1519.                 "menu"        {htmlElemMenu}
  1520.                 "new list entry"    {htmlElemListEntry}
  1521.                 "discursive"    {htmlBuildDiscList}
  1522.                 "new discursive entry"    {htmlElemDiscEntry}
  1523.             }
  1524.         }
  1525.         "Forms" {
  1526.             switch $item {
  1527.                 form        {htmlElemForm}
  1528.                 select        {htmlElemSelect}
  1529.                 option        {htmlElemOption}
  1530.                 input        {htmlElemInput}
  1531.                 textarea    {htmlElemTextarea}
  1532.             }
  1533.         }
  1534.         "Tables" {
  1535.             switch $item {
  1536.                 table    {htmlElemTable}
  1537.                 tr        {htmlElemTR}
  1538.                 td        {htmlElemTD}
  1539.                 th        {htmlElemTH}
  1540.                 caption    {htmlElemCaption}
  1541.             }
  1542.         }
  1543.         "Character Entities"    {
  1544.             switch $item {
  1545.                 "Add"    {htmlAddCommonChars}
  1546.                 "Clear"    {htmlClearCommonChars}
  1547.                 "less than"    {htmlLt}
  1548.                 "greater than"    {htmlGt}
  1549.                 "ampersand"    {htmlAmp}
  1550.                 default        {
  1551.                     htmlGetSel
  1552.                     if {$htmlIsSel} { deleteSelection }
  1553.                      # set item [string trim $item]
  1554.                     insertText &${item}\;
  1555.                 }
  1556.             }
  1557.         }
  1558.         "all chars" {
  1559.             switch $item {
  1560.                 default        {
  1561.                     htmlGetSel
  1562.                     if {$htmlIsSel} { deleteSelection }
  1563.                      # set item [string trim $item]
  1564.                     insertText &${item}\;
  1565.                 }
  1566.             }
  1567.         }
  1568.         "Other Elements"    {
  1569.             switch $item {
  1570.                 "line break"        {htmlBreak}
  1571.                 "horizontal rule"    {htmlElemHR}
  1572.                 "comment line"    {htmlDividingLine}
  1573. #                 "processing instructions"    {htmlElemPI}
  1574.                 "base"    {htmlElemBase}
  1575.                 "isindex" {insertText [htmlOpenElem "ISINDEX"]}
  1576.                 "link"    {htmlBuildCRElem "LINK"}
  1577.                 "meta"    {insertText [htmlOpenElem "META"]}
  1578.                 "nextid"    {insertText [htmlOpenElem "NEXTID"]}
  1579.                 "title"            {htmlElemTitle}
  1580.             }
  1581.         }
  1582.         "Custom"    {
  1583.             catch {htmlElem${item}}
  1584.         }
  1585.         "URLs"    {
  1586.             switch $item {
  1587.                 "Add selection"    {htmlSelToURL}
  1588.                 "Add clipboard"    {htmlScrapToURL}
  1589.                 "Clean up"        {htmlCleanUpURLs}
  1590.             }
  1591.         }
  1592.         "Use Attributes"    {
  1593.             htmlUseAttrs $item
  1594.         }
  1595.         "HTML Helpers"    {
  1596.             switch $item {
  1597.                 "Send file to browser"    {htmlSendWindow}
  1598.                 "Weblint"    {htmlNotYet}
  1599.             }
  1600.         }
  1601.     }
  1602. }
  1603.  
  1604. #
  1605. # The menu.
  1606. #
  1607. # This is built up with lappends because I want parts of it to be 
  1608. # dynamic, to depend on which elements have attributes defined on 
  1609. # them and whether using ctl-cmd.
  1610. #
  1611. # After Pete's bug fixes, put icons in menus dynamically.
  1612. # ctrl is B, opt is I, cmd is O, shift is U, dynamic is S
  1613. #
  1614. proc htmlBuildMenu {} {
  1615.     global htmlCustomMenuList htmlElemAttrAll 
  1616.     global htmlMenu HTMLmodeVars htmlAllChars 
  1617.     set commonChars $HTMLmodeVars(commonChars)
  1618.     set Mstr    $HTMLmodeVars(htmlMenuPrefix)
  1619.     set SMstr    $HTMLmodeVars(htmlSMenuPrefix)
  1620.  
  1621.     # start empty
  1622.     set htmlMenuList {}
  1623.  
  1624.     # Header1, Header2...
  1625.     set htmlHeadersMenu [list menu -M HTML -p htmlMenuItem -m -n Headers \
  1626.         [list ${Mstr}/1Header1 ${Mstr}/2Header2 ${Mstr}/3Header3 ${Mstr}/4Header4 \
  1627.         ${Mstr}/5Header5 ${Mstr}/6Header6]]
  1628.     lappend htmlMenuList $htmlHeadersMenu
  1629.     
  1630.  
  1631.     # Blocks
  1632.     set htmlBlocksMenu [list menu -M HTML -p htmlMenuItem -m -n "Text Blocks" \
  1633.         [list "${Mstr}/aparagraph" "${Mstr}/;comment" \
  1634.         ${Mstr}/Aaddress "${Mstr}/Qblock quote" \
  1635.         ${Mstr}/Ppreformatted center]]
  1636.     lappend htmlMenuList $htmlBlocksMenu
  1637.  
  1638.  
  1639.     # Styles
  1640.     set htmlStylesMenu [list menu -M HTML -p htmlMenuItem -m -n Styles \
  1641.         [list ${Mstr}/Eemphasis ${Mstr}/Sstrong ${Mstr}/Bbold ${Mstr}/Iitalic \
  1642.         ${Mstr}/Ccode ${Mstr}/Vvariable ${SMstr}/Ccitation ${Mstr}/Kkeyboard \
  1643.         ${Mstr}/Ftypewriter sample]]
  1644.     lappend htmlMenuList $htmlStylesMenu
  1645.     
  1646.  
  1647.     # Links
  1648.     set htmlLinksMenu [list menu -M HTML -p htmlMenuItem -m -n Links \
  1649.         [list ${Mstr}/>href ${Mstr}/<anchor ${Mstr}/\/image]]
  1650.     lappend htmlMenuList $htmlLinksMenu
  1651.  
  1652.  
  1653.     # Lists    
  1654.     set htmlListsMenu [list menu -M HTML -p htmlMenuItem -m -n Lists \
  1655.         [list ${Mstr}/Ubulleted ${Mstr}/Onumbered ${Mstr}/Ddirectory \
  1656.         ${Mstr}/Mmenu "${Mstr}/Nnew list entry" "(-" \
  1657.         ${Mstr}/Gdiscursive "${SMstr}/Nnew discursive entry"]]
  1658.     lappend htmlMenuList $htmlListsMenu
  1659.  
  1660.  
  1661.     # Forms
  1662.     set htmlFormsMenu [list menu -M HTML -p htmlMenuItem -m -n Forms \
  1663.         [list ${SMstr}/Fform ${SMstr}/Sselect ${SMstr}/Ooption \
  1664.         ${SMstr}/Iinput ${SMstr}/Ttextarea]]
  1665.     lappend htmlMenuList $htmlFormsMenu
  1666.     
  1667.     
  1668.     # Tables
  1669.     set htmlTablesMenu [list menu -M HTML -p htmlMenuItem -m -n Tables \
  1670.         [list table tr td th caption]]
  1671.     lappend htmlMenuList $htmlTablesMenu
  1672.     
  1673.  
  1674.     # Character Entities
  1675.     set htmlAllChars {
  1676.         "aacute"
  1677.         "acirc"
  1678.         "acircumflex"
  1679.         "adieresis"
  1680.         "ae"
  1681.         "aelig"
  1682.         "agrave"
  1683.         "amp"
  1684.         "apple"
  1685.         "approxequal"
  1686.         "aring"
  1687.         "atilde"
  1688.         "auml"
  1689.         "breve"
  1690.         "bullet"
  1691.         "caron"
  1692.         "ccedil"
  1693.         "ccedilla"
  1694.         "cedilla"
  1695.         "cent"
  1696.         "circumflex"
  1697.         "copy"
  1698.         "copyright"
  1699.         "currency"
  1700.         "dagger"
  1701.         "daggerdbl"
  1702.         "degree"
  1703.         "dieresis"
  1704.         "divide"
  1705.         "dotaccent"
  1706.         "dotlessi"
  1707.         "eacute"
  1708.         "ecirc"
  1709.         "ecircumflex"
  1710.         "edieresis"
  1711.         "egrave"
  1712.         "ellipsis"
  1713.         "emdash"
  1714.         "emsp"
  1715.         "endash"
  1716.         "ensp"
  1717.         "eth"
  1718.         "euml"
  1719.         "exclamdown"
  1720.         "fi"
  1721.         "fl"
  1722.         "florin"
  1723.         "fraction"
  1724.         "germandbls"
  1725.         "greaterequal"
  1726.         "gt"
  1727.         "guillemotleft"
  1728.         "guillemotright"
  1729.         "guilsinglleft"
  1730.         "guilsinglright"
  1731.         "hellip"
  1732.         "hungarumlaut"
  1733.         "iacute"
  1734.         "icirc"
  1735.         "icircumflex"
  1736.         "idieresis"
  1737.         "igrave"
  1738.         "infinity"
  1739.         "integral"
  1740.         "iuml"
  1741.         "lessequal"
  1742.         "logicalnot"
  1743.         "lozenge"
  1744.         "lre"
  1745.         "lrm"
  1746.         "lro"
  1747.         "lt"
  1748.         "macron"
  1749.         "mdash"
  1750.         "mu"
  1751.         "nbsp"
  1752.         "ndash"
  1753.         "nobrkspace"
  1754.         "notequal"
  1755.         "ntilde"
  1756.         "oacute"
  1757.         "ocirc"
  1758.         "ocircumflex"
  1759.         "odieresis"
  1760.         "oe"
  1761.         "ogonek"
  1762.         "ograve"
  1763.         "ordfeminine"
  1764.         "ordmasculine"
  1765.         "oslash"
  1766.         "otilde"
  1767.         "ouml"
  1768.         "paragraph"
  1769.         "partialdiff"
  1770.         "pdf"
  1771.         "periodcentered"
  1772.         "perthousand"
  1773.         "pi"
  1774.         "plusminus"
  1775.         "questiondown"
  1776.         "quot"
  1777.         "quotedblbase"
  1778.         "quotedblleft"
  1779.         "quotedblright"
  1780.         "quoteleft"
  1781.         "quoteright"
  1782.         "quotesinglbase"
  1783.         "radical"
  1784.         "registered"
  1785.         "ring"
  1786.         "rlm"
  1787.         "rlo"
  1788.         "section"
  1789.         "shy"
  1790.         "sterling"
  1791.         "szlig"
  1792.         "thorn"
  1793.         "tilde"
  1794.         "trademark"
  1795.         "uacute"
  1796.         "ucirc"
  1797.         "ucircumflex"
  1798.         "udieresis"
  1799.         "ugrave"
  1800.         "uuml"
  1801.         "vellip"
  1802.         "yacute"
  1803.         "ydieresis"
  1804.         "yen"
  1805.         "yuml"
  1806.         "zwj"
  1807.         "zwnj"
  1808.         "(-"
  1809.         "Aacute"
  1810.         "Acirc"
  1811.         "Acircumflex"
  1812.         "Adieresis"
  1813.         "AE"
  1814.         "AElig"
  1815.         "Agrave"
  1816.         "Aring"
  1817.         "Atilde"
  1818.         "Auml"
  1819.         "Ccedil"
  1820.         "Ccedilla"
  1821.         "Delta"
  1822.         "Eacute"
  1823.         "Ecirc"
  1824.         "Ecircumflex"
  1825.         "Edieresis"
  1826.         "Egrave"
  1827.         "Eth"
  1828.         "Euml"
  1829.         "Iacute"
  1830.         "Icirc"
  1831.         "Icircumflex"
  1832.         "Idieresis"
  1833.         "Igrave"
  1834.         "Iuml"
  1835.         "Ntilde"
  1836.         "OE"
  1837.         "Oacute"
  1838.         "Ocirc"
  1839.         "Ocircumflex"
  1840.         "Odieresis"
  1841.         "Ograve"
  1842.         "Omega"
  1843.         "Oslash"
  1844.         "Otilde"
  1845.         "Ouml"
  1846.         "Pi"
  1847.         "Sigma"
  1848.         "Thorn"
  1849.         "Uacute"
  1850.         "Ucirc"
  1851.         "Ucircumflex"
  1852.         "Udieresis"
  1853.         "Ugrave"
  1854.         "Uuml"
  1855.         "Yacute"
  1856.         "Ydieresis"
  1857.         "Ygrave"
  1858.     }
  1859.     set htmlAllCharsMenu [list menu -M HTML -p htmlMenuItem -m -n "all chars" $htmlAllChars ]
  1860.     set tmp $commonChars
  1861.     lappend tmp "(-" Add Clear $htmlAllCharsMenu
  1862.     set htmlCharsMenu [list menu -M HTML -p htmlMenuItem -m -n "Character Entities" $tmp]
  1863.     lappend htmlMenuList $htmlCharsMenu
  1864.  
  1865.  
  1866.     # Other stuff, miscellaneous
  1867.     set htmlOtherMenu [list menu -M HTML -p htmlMenuItem -m -n "Other Elements" \
  1868.         [list "${Mstr}/!line break" "horizontal rule" "comment line" \
  1869.         "(-" base isindex link meta nextid title]]
  1870.     lappend htmlMenuList $htmlOtherMenu
  1871.  
  1872.  
  1873.     # Allow user to insert custom menu items
  1874.     if {![info exists htmlCustomMenuList]} { set htmlCustomMenuList {} }
  1875.     set htmlCustomMenu [list menu -M HTML -p htmlMenuItem -m -n "Custom" $htmlCustomMenuList]
  1876.     lappend htmlMenuList $htmlCustomMenu
  1877.  
  1878.     # Other top-level
  1879.     lappend htmlMenuList "(-" "/BSelect Container" ${SMstr}/UUntag "<O/cRemove marks" "${Mstr}/0New doc template" 
  1880.     
  1881.     # URLs
  1882.     set htmlURLsMenu [list menu -M HTML -p htmlMenuItem -m -n "URLs" [list "Add selection" \
  1883.             "Add clipboard" "Clean up"]]
  1884.     lappend htmlMenuList $htmlURLsMenu
  1885.  
  1886.     # Use Attributes
  1887.     # Dynamically-built list of elements whose default attributes can be selected
  1888.     foreach a [array names htmlElemAttrAll] {
  1889.         if {[llength $htmlElemAttrAll($a)]} {lappend htmlPossibleToUse $a}
  1890.     }
  1891.     lappend htmlPossibleToUse "A HREF" "A ANCHOR"
  1892.     set htmlUseAttrsMenu [list menu -M HTML -p htmlMenuItem -m -n "Use Attributes" \
  1893.         [lsort $htmlPossibleToUse]]
  1894.     lappend htmlMenuList $htmlUseAttrsMenu
  1895.  
  1896.     # Helpers
  1897.     set htmlHelpersMenu [list menu -M HTML -p htmlMenuItem -m -n "HTML Helpers" {"<O<U/SSend file to browser" "Weblint"}]
  1898.     lappend htmlMenuList $htmlHelpersMenu
  1899.     
  1900.     # Put it all together
  1901.     menu -M HTML -m  -p htmlMenuItem -n $htmlMenu $htmlMenuList    
  1902.     insertMenu $htmlMenu
  1903. }
  1904.     
  1905. #===============================================================================
  1906. # Key Bindings and Menu Definitions
  1907. #
  1908. # We make menu definition dynamic so that the little icons can change someday.
  1909. #===============================================================================
  1910.  
  1911. proc htmlBindKeys {} {
  1912.     global HTMLmodeVars htmlElemAttrAll
  1913.     global htmlMenu htmlCustomMenuList 
  1914.     set htmlBStr  $HTMLmodeVars(htmlBindPrefix) 
  1915.     set htmlSBStr $HTMLmodeVars(htmlSBindPrefix)
  1916.  
  1917. #     # key bindings and menu entries look different if usectlcmd.
  1918. #     catch {set useCtlCmd $HTMLmodeVars(useCtlCmd)}
  1919. #     if {![info exists useCtlCmd]} {set useCtlCmd 0}
  1920. #     if ($useCtlCmd) {
  1921. #         set htmlBStr "zc"
  1922. #         set htmlSBStr "szc"
  1923. #         set htmlMStr "B"
  1924. #     } else {
  1925. #         set htmlBStr "oz"
  1926. #         set htmlSBStr "soz"
  1927. #         set htmlMStr "O"
  1928. #     }
  1929.     set htmlBStr "oz"
  1930.     set htmlSBStr "soz"
  1931.     set htmlMStr "O"
  1932.  
  1933.     catch {deleteModeBindings HTML}
  1934.     
  1935.     # tabs to tabmarks (Ñ)
  1936.     bind '\t'        htmlTabNext    HTML
  1937.     bind '\t'    <s> htmlTabPrev    HTML
  1938.     bind '\t'    <c> htmlTabDeleteAll    HTML
  1939.     # balance & untag
  1940.     bind 'b'    <c>    htmlBalance    HTML
  1941.     bind 'u'    <$htmlSBStr>    htmlUnTag    HTML
  1942.  
  1943.     #cmd-opt keys, in the same order as the menu
  1944.  
  1945.     #
  1946.     # new file template and headers
  1947.     #
  1948.     # a '0' sort of comes before any heading
  1949.     bind '0'    <$htmlBStr>    htmlNewTemplate    HTML
  1950.     bind '1'    <$htmlBStr>    htmlElemHeader1    HTML
  1951.     bind '2'     <$htmlBStr>    htmlElemHeader2    HTML
  1952.     bind '3'     <$htmlBStr>    htmlElemHeader3    HTML
  1953.     bind '4'     <$htmlBStr>    htmlElemHeader4    HTML
  1954.     bind '5'     <$htmlBStr>    htmlElemHeader5    HTML
  1955.     bind '6'     <$htmlBStr>    htmlElemHeader6    HTML
  1956.  
  1957.     #
  1958.     # Text Blocks
  1959.     #
  1960.     # paragraph: Enter
  1961.     bind Enter        htmlElemParagraph            HTML
  1962.     bind '\r'    <$htmlBStr>    htmlElemParagraph    HTML
  1963.     # for PowerBook 100
  1964.     bind 0x34        htmlElemParagraph            HTML
  1965.     # Also on ctrl-M for those with awkward Enter keys
  1966.     bind 'm'    <z>    htmlElemParagraph            HTML
  1967.     
  1968.     # Comment on semicolon
  1969.     bind 0x29    <$htmlBStr>    htmlComment        HTML
  1970.     
  1971.     bind 'a'    <$htmlBStr>    htmlElemAddress            HTML
  1972.     bind 'q'    <$htmlBStr>    htmlElemBlockquote        HTML
  1973.     bind 'p'    <$htmlBStr>    htmlElemPreformatted    HTML
  1974.     # CENTER doesn't have a binding, since it will most likely go away
  1975.     
  1976.     #
  1977.     # Styles
  1978.     #
  1979.     bind 'e'    <$htmlBStr>    htmlElemEmphasized    HTML
  1980.     bind 's'    <$htmlBStr>    htmlElemStrong        HTML
  1981.     bind 'b'    <$htmlBStr>    htmlElemBold        HTML
  1982.     bind 'c'    <$htmlBStr>    htmlElemCode        HTML
  1983.     bind 'v'    <$htmlBStr>    htmlElemVarname        HTML
  1984.     bind 'c'    <$htmlSBStr>    htmlElemCite    HTML
  1985.     bind 'k'    <$htmlBStr>    htmlElemKeyboard    HTML
  1986.     bind 'i'    <$htmlBStr>    htmlElemItalic        HTML
  1987.     bind 'f'    <$htmlBStr>    htmlElemTT            HTML
  1988.     
  1989.     #
  1990.     # Links
  1991.     #
  1992.     # A "<" is something pointed at.  ">" points to it.
  1993.     bind '.'    <$htmlBStr>    htmlElemHref    HTML
  1994.     bind ','    <$htmlBStr>    htmlElemAnchor    HTML
  1995.     # An image, right near the usual href
  1996.     bind '/'    <$htmlBStr>    htmlElemImg    HTML
  1997.     
  1998.     #
  1999.     # Lists
  2000.     #
  2001.     bind 'u'    <$htmlBStr>    htmlElemBulleted        HTML
  2002.     bind 'o'    <$htmlBStr>    htmlElemNumbered            HTML
  2003.     bind 'd'    <$htmlBStr>    htmlElemDirectory        HTML
  2004.     bind 'm'    <$htmlBStr>    htmlElemMenu            HTML
  2005.     # n is for 'eNtry'
  2006.     bind 'n'    <$htmlBStr>    htmlElemListEntry        HTML
  2007.     bind 'g'    <$htmlBStr>    htmlBuildDiscList        HTML
  2008.     # A discursive list entry is N with the shift key
  2009.     bind 'n'    <$htmlSBStr>    htmlElemDiscEntry    HTML
  2010.     
  2011.     #
  2012.     # Forms
  2013.     #
  2014.     bind 'f'    <$htmlSBStr>    htmlElemForm        HTML
  2015.     bind 's'    <$htmlSBStr>    htmlElemSelect        HTML
  2016.     bind 'o'    <$htmlSBStr>    htmlElemOption        HTML
  2017.     bind 'i'    <$htmlSBStr>    htmlElemInput        HTML
  2018.     bind 't'    <$htmlSBStr>    htmlElemTextarea    HTML
  2019.  
  2020.     #
  2021.     # Other Elements
  2022.     #
  2023.     # break is '!', shift-cmd-opt-1
  2024.     bind '!'    <$htmlBStr>    htmlBreak        HTML
  2025.     # comment line is ctrl-C L
  2026.     bind 'l'     <C> htmlDividingLine    HTML
  2027.     
  2028.     #
  2029.     # Character entities
  2030.     #
  2031.     # Only <, > and & are bound, to shift-cmd-opt-<char>
  2032.     bind '<'    <$htmlBStr>    htmlLt    HTML
  2033.     bind '>'    <$htmlBStr>    htmlGt    HTML
  2034.     bind '&'    <$htmlBStr>    htmlAmp    HTML
  2035.     
  2036.     #
  2037.     # Helpers
  2038.     #
  2039.     bind right    <$htmlBStr>    htmlSendWindow    HTML
  2040.  
  2041.  
  2042. }
  2043.  
  2044. htmlBindKeys
  2045. htmlBuildMenu
  2046.  
  2047. #===============================================================================
  2048. # General Commands
  2049. #===============================================================================
  2050.  
  2051. # remove containing tags
  2052. proc htmlUnTag {} {
  2053.     set curPos [getPos]
  2054.     set tags [htmlGetContainer $curPos [selEnd]]
  2055.     if {[llength $tags] < 4} {
  2056.         alertnote "Cannot decide on enclosing tags"
  2057.         return
  2058.     }
  2059.     # delete them back to front
  2060.     createTMark htmlUnTagMark $curPos
  2061.     deleteText [lindex $tags 2] [lindex $tags 3]
  2062.     deleteText [lindex $tags 0] [lindex $tags 1]
  2063.     gotoTMark htmlUnTagMark
  2064.     removeTMark htmlUnTagMark
  2065. }
  2066.  
  2067. # select container, like Balance (cmd-B)
  2068. proc htmlBalance {} {
  2069.     # if </, stay there.  If <?, back up one if possible
  2070.     # watch out for end of file, beginning of file
  2071.     set begin [getPos]
  2072.     set end   [selEnd]
  2073.     
  2074.     set start $begin
  2075.     if {$start != 0 &&
  2076.             ![catch {getText $start [expr $start + 2]} lookingAt] &&
  2077.             $lookingAt != "</" &&
  2078.             [string range $lookingAt 0 0] == "<"} {
  2079.         set start [expr [getPos] - 1]
  2080.     }
  2081.     set tags [htmlGetContainer $start $end]
  2082.     if {[llength $tags] == 4} {
  2083.         select [lindex $tags 0] [lindex $tags 3]
  2084.     } else {
  2085.         beep
  2086.         select $begin $end
  2087.     }
  2088. }
  2089.  
  2090. #
  2091. # launch a viewer and pass this window to it
  2092. #
  2093. proc htmlSendWindow {} {
  2094.     global htmlBrowserPath HTMLmodeVars
  2095.     if {![info exists htmlBrowserPath]} {
  2096.         if {[catch {addAppPath "HTML Browser" htmlBrowserPath}]} {
  2097.             alertnote "You must choose a browser"
  2098.             return
  2099.         }
  2100.     }
  2101.     set sig [getFileSig $htmlBrowserPath] 
  2102.     
  2103.     set name [checkRunning "HTML Browser" $sig htmlBrowserPath]
  2104.     if {![string length $name]} {
  2105.         alertnote "Couldn't run browser"
  2106.         return
  2107.     }
  2108.  
  2109.     if {[winDirty]} {
  2110.         case [askyesno -c "Save '[lindex [winNames] 0]'?"] in {
  2111.             "yes" {save}
  2112.             "no" {}
  2113.             "cancel" {return}
  2114.         }
  2115.     }
  2116.     sendOpenEvent -n $name [lindex [winNames -f] 0]
  2117.      if {$HTMLmodeVars(browseInForeground)} { switchTo $name }
  2118. }
  2119.  
  2120.  
  2121. proc htmlCleanUpURLs {} {
  2122.     global HTMLmodeVars 
  2123.     global modifiedModeVars
  2124.     set URLs $HTMLmodeVars(URLs)
  2125.  
  2126.     if {![llength $URLs]} {
  2127.         alertnote "No URLs are cached"
  2128.         return 1
  2129.     }
  2130.     if {![catch {listpick -l -p "Select the URLs to save" $URLs} newURLs]} {
  2131.         set URLs [eval concat $newURLs]
  2132.         set HTMLmodeVars(URLs) $URLs
  2133.         lappend modifiedModeVars {URLs HTMLmodeVars}
  2134.     }
  2135. }
  2136.  
  2137. proc htmlSelToURL {} {
  2138.     global HTMLmodeVars modifiedModeVars
  2139.     set URLs $HTMLmodeVars(URLs)
  2140.  
  2141.     set URLs [lsort [lappend URLs [getSelect]]]
  2142.     set HTMLmodeVars(URLs) $URLs
  2143.     lappend modifiedModeVars {URLs HTMLmodeVars}
  2144.     message [append tmp [getSelect] " added to URLs"]
  2145. }
  2146.  
  2147. proc htmlScrapToURL {} {
  2148.     global HTMLmodeVars modifiedModeVars
  2149.     set URLs $HTMLmodeVars(URLs)
  2150.  
  2151.     set URLs [lsort [lappend URLs [getScrap]]]
  2152.     set HTMLmodeVars(URLs) $URLs
  2153.     lappend modifiedModeVars {URLs HTMLmodeVars}
  2154.     message [append tmp [getScrap] " added to URLs"]
  2155. }
  2156.  
  2157. # called by Alpha to load HTML in.  Use to force template in new empty window.
  2158. proc htmlDummy {} {
  2159. #     if {![maxPos]} {
  2160. #         htmlNewTemplate
  2161. #     }
  2162. }
  2163.